home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMIBEST1.ADF / AmigaBasicStuff / HouseHold / HouseInvPrint < prev    next >
Text File  |  1987-07-22  |  10KB  |  393 lines
  1. ' The Household Inventory Report Program
  2. ' --------------------------------------
  3. ' This is Program #2 of 3: :"HouseInvPrint" -reports
  4. ' Program #1 is the "HouseInv" (main) program
  5. ' Program #3 is the "HouseInvMaint" program
  6. '
  7. ' Please do not modify the title screen in any way.
  8. ' January 1987
  9. '
  10. numbx=2:RecCnt=0:n=0:m=0:i=0:ErrSW=0:type=0:PageCnt=0:LineCnt=0
  11. LoadSW=0:Limit=0:Ptr1=0:Ptr2=0:offset=0:lgth=0
  12. A%=0:B%=0
  13. NewSeq$="":OldSeq$="":Sep$="":x$=""
  14. DIM bx(numbx-1,6),bxtxt$(numbx-1)
  15. Logo80 3
  16. BldGadgets numbx,bx(),bxtxt$()
  17. ' Help Gadgets
  18. DATA  36,172,40,16,7,4,0,"More"
  19. DATA 156,172,40,16,7,2,0," Ok"
  20. HlpA%=0:HlpB%=1
  21. COLOR Blu,Blk
  22. LOCATE  9,39:PRINT"THE"
  23. LOCATE 11,22:PRINT"H O U S E H O L D   I N V E N T O R Y"
  24. LOCATE 13,38:PRINT"SYSTEM"
  25. COLOR Mag,Blk
  26. LOCATE 16,28:PRINT"P R I N T   R E P O R T S"
  27. MENU 1,0,1,"Project:"
  28. MENU 1,1,1,"Quit    "
  29. MENU 2,0,1,"Help:"
  30. MENU 2,1,1,"General    "
  31. MENU 2,2,1,"Order Entry"
  32. MENU 2,3,1,"By Room    "
  33. MENU 2,4,1,"By Item    "
  34. MENU 3,0,1,"Report:"
  35. MENU 3,1,1,"Order Entry"
  36. MENU 3,2,1,"By Room    "
  37. MENU 3,3,1,"By Item    "
  38. MENU 4,0,0,""
  39. ON MENU GOSUB GetMenu
  40. ON MOUSE GOSUB GetMouse
  41. COLOR Yel,Blk:LOCATE 21,23
  42. PRINT"Use Menus to select program function"
  43. MENU ON
  44. WaitHere:
  45. MENU 2,0,1:MENU 3,0,1
  46. m=0:i=0:WHILE m=0:SLEEP:WEND
  47. MENU 2,0,0:MENU 3,0,0
  48. ON m GOTO Quit,Help,Report
  49.  
  50. ' Menu Event Routine
  51. ' ------------------
  52. GetMenu:
  53. m=MENU(0):i=MENU(1)
  54. RETURN
  55.  
  56. ' Mouse Event Routine
  57. ' -------------------
  58. GetMouse:
  59. GetGadget A%,B%,bx(),bxtxt$(),type
  60. RETURN
  61.  
  62. ' Wait for Mouse Click
  63. ' --------------------
  64. WaitMouse:
  65. MOUSE ON
  66. type=0:WHILE type=0:SLEEP:WEND
  67. MOUSE OFF
  68. RETURN
  69.  
  70. ' Open and Load Data File
  71. ' -----------------------
  72. OpenAndLoad:
  73. ON ERROR GOTO CountError
  74. OPEN"HouseInv.Count" FOR INPUT AS #2
  75. ON ERROR GOTO 0
  76. INPUT #2,RecCnt
  77. CLOSE #2
  78. IF RecCnt=0 THEN OALXit
  79. WINDOW 3,,(440,40)-(608,96),0,1
  80. COLOR Blu,Yel:CLS
  81. LOCATE 2,2:PRINT"Loading File..."
  82. OPEN "R",#1,"HouseInv.Data",103
  83. FIELD #1,1 AS FFlg$,10 AS d$(0),15 AS d$(1),8 AS d$(2),6 AS d$(3),6 AS d$(4),6 AS d$(5),15 AS d$(6),20 AS d$(7),8 AS d$(8),8 AS d$(9)
  84. DIM Records$(RecCnt)
  85. FOR n=1 TO RecCnt
  86.   GET #1,n
  87.   IF FFlg$="0" THEN Sep$=" " ELSE Sep$="*"
  88.   Records$(n)=Sep$
  89.   FOR m=0 TO 9
  90.     Records$(n)=Records$(n)+d$(m)+Sep$
  91.   NEXT
  92. NEXT
  93. CLOSE #1:LoadSW=1:ErrSW=0
  94. WINDOW CLOSE 3
  95. GOTO OALXit
  96.  
  97. CountError:
  98. WINDOW 2
  99. IF ERR=53 THEN
  100.   LoadSW=0:ErrSW=1:RESUME OALXit
  101. ELSE
  102.   ON ERROR GOTO 0
  103. END IF
  104.  
  105. OALXit:
  106. RETURN
  107.  
  108. ' Time to Quit and Return to Basic
  109. ' --------------------------------
  110. Quit:
  111. MENU OFF:MENU RESET
  112. WINDOW CLOSE 2:SCREEN CLOSE 1
  113. END
  114.  
  115. ' Help Routines
  116. ' -------------
  117. Help:
  118. GOSUB DoHelp
  119. GOTO WaitHere
  120.  
  121. ' Generate Requested Report
  122. ' -------------------------
  123. Report:
  124. IF i=1 THEN NewSeq$="ASIS"
  125. IF i=2 THEN NewSeq$="ROOM"
  126. IF i=3 THEN NewSeq$="ITEM"
  127. IF LoadSW=0 THEN GOSUB OpenAndLoad
  128. IF ErrSW=1 OR RecCnt=0 THEN
  129.   WINDOW 3,,(440,40)-(608,92),0,1
  130.   COLOR Blu,Yel:CLS
  131.   LOCATE 2,3:PRINT"File is  empty  or"
  132.   LOCATE 3,3:PRINT"does not exist."
  133.   LOCATE 5,3:PRINT"Press left  button"
  134.   LOCATE 6,3:PRINT"to continue."
  135.   WHILE MOUSE(0)=0:WEND
  136.   WINDOW CLOSE 3
  137.   GOTO RptXit
  138. END IF
  139. IF NewSeq$=OldSeq$ OR NewSeq$="ASIS" THEN DoPrint
  140.  
  141. ' Looks Like We Have to Sort the File
  142. WINDOW 3,,(440,40)-(608,92),0,1
  143. COLOR Blu,Yel:CLS
  144. LOCATE 2,3:PRINT"Sorting File..."
  145. OldSeq$=NewSeq$
  146. Limit=1:WHILE Limit<=RecCnt:Limit=2*Limit:WEND
  147. HalfIt:
  148. Limit=INT(Limit/2)
  149. IF Limit=0 THEN SortDone
  150. FOR n=1 TO RecCnt-Limit
  151.   Ptr1=n
  152.   WHILE Ptr1>0
  153.     Ptr2=Ptr1+Limit
  154.     IF NewSeq$="ROOM" THEN offset=2:lgth=10
  155.     IF NewSeq$="ITEM" THEN offset=13:lgth=15
  156.     IF MID$(Records$(Ptr1),offset,lgth)>MID$(Records$(Ptr2),offset,lgth) THEN
  157.       SWAP Records$(Ptr1),Records$(Ptr2)
  158.       Ptr1=Ptr1-Limit
  159.     ELSE
  160.       Ptr1=0
  161.     END IF
  162.   WEND
  163. NEXT
  164. GOTO HalfIt
  165. SortDone:
  166. MENU 3,1,0
  167. WINDOW CLOSE 3
  168.  
  169. ' And Now to Print the Report
  170. DoPrint:
  171. WINDOW 3,,(440,40)-(608,92),0,1
  172. COLOR Blu,Yel:CLS
  173. LOCATE 2,4:PRINT"Now Printing..."
  174. OPEN "PRT:" FOR OUTPUT AS #3
  175. GOSUB PageHdg
  176. FOR n=1 TO RecCnt
  177.   IF LineCnt>55 THEN GOSUB NewPage:GOSUB PageHdg
  178.   IF NewSeq$="ITEM" THEN
  179.     x$=MID$(Records$(n),12,16)
  180.     x$=x$+MID$(Records$(n),1,11)
  181.     x$=x$+MID$(Records$(n),28,46)
  182.   ELSE
  183.     x$=MID$(Records$(n),1,73)
  184.   END IF
  185.   PRINT #3,"   "+x$
  186.   PRINT #3,SPACE$(30)+MID$(Records$(n),74)
  187.   LineCnt=LineCnt+2
  188. NEXT
  189. GOSUB NewPage:PageCnt=0:CLOSE #3
  190. GOTO RptXit
  191.  
  192. NewPage:
  193. PRINT #3,CHR$(12);
  194. RETURN
  195.  
  196. PageHdg:
  197. PRINT #3," ":PageCnt=PageCnt+1
  198. PRINT #3,SPACE$(37);
  199. PRINT #3,USING"-##";PageCnt;:PRINT #3,"-"
  200. PRINT #3,SPACE$(8);
  201. PRINT #3,CHR$(27)+"[6w";: 'Set Double width
  202. PRINT #3,"The Household Inventory Program";
  203. PRINT #3,CHR$(27)+"[5w": 'Set normal width
  204. PRINT #3," "
  205. IF NewSeq$="ITEM" THEN
  206.   PRINT #3,"    Item==========> Room=====>";
  207. ELSE
  208.   PRINT #3,"    Room=====> Item==========>";
  209. END IF
  210. PRINT #3," Pur-Data OrCost CWorth RpCost Serial-Number=>"
  211. PRINT #3,SPACE$(31)+"Comments===========> Add-Date Chg-Date"
  212. PRINT #3,"    "+STRING$(72,"-")
  213. LineCnt=9
  214. RETURN
  215.  
  216. RptXit:
  217. WINDOW CLOSE 3
  218. GOTO WaitHere
  219.  
  220. ' Help Routines (requested via Help Menu)
  221. ' ---------------------------------------
  222. DoHelp:
  223. WINDOW 4,,(408,0)-(631,186),0,1
  224. COLOR Blu,Yel:CLS:LOCATE 2,1
  225. ON i GOTO HlpGen,HlpASIS,HlpROOM,HlpITEM
  226. HlpGen:
  227. PRINT" 'HouseInvPrint'  uses   a"
  228. PRINT" data   file  created   by"
  229. PRINT" 'HouseInv'  as input  and"
  230. PRINT" produces  three   reports"
  231. PRINT" from   the  contents   of"
  232. PRINT" that file.":PRINT" "
  233. PRINT" A     third      program,"
  234. PRINT" 'HouseInvMaint'  is  used"
  235. PRINT" for functions related  to"
  236. PRINT" the  maintenance  of  the"
  237. PRINT" file itself, (rather than"
  238. PRINT" the contents)."
  239. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  240. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  241. GOTO HlpXit
  242. HlpASIS:
  243. PRINT" The report is produced in"
  244. PRINT" the same sequence as that"
  245. PRINT" in  which the items  were"
  246. PRINT" entered.":PRINT" "
  247. PRINT" This option is only valid"
  248. PRINT" before  a report  of  any"
  249. PRINT" other  sequence  is  pro-"
  250. PRINT" duced.":PRINT" "
  251. GOSUB HelpCommon
  252. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  253. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  254. GOTO HlpXit
  255. HlpROOM:
  256. PRINT" The  list  of  items   is"
  257. PRINT" sorted into room sequence"
  258. PRINT" before   the  report   is"
  259. PRINT" printed.":PRINT" "
  260. GOSUB HelpCommon:PRINT" "
  261. PRINT" N.B.  An   'Order  Entry'"
  262. PRINT" report   is   no   longer"
  263. PRINT" available."
  264. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  265. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  266. GOTO HlpXit
  267. HlpITEM:
  268. PRINT" The  list  of  items   is"
  269. PRINT" sorted into item sequence"
  270. PRINT" before   the  report   is"
  271. PRINT" printed.":PRINT" "
  272. GOSUB HelpCommon:PRINT" "
  273. PRINT" N.B.  An   'Order  Entry'"
  274. PRINT" report   is   no   longer"
  275. PRINT" available."
  276. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  277. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  278. GOTO HlpXit
  279. HelpCommon:
  280. PRINT" Items  which  have   been"
  281. PRINT" deleted, but not yet  re-"
  282. PRINT" moved   from  the   file,"
  283. PRINT" (see    'HouseInvMaint'),"
  284. PRINT" are  listed with  an  '*'"
  285. PRINT" separating the pieces  of"
  286. PRINT" information."
  287. RETURN
  288.  
  289. HlpXit:
  290. WINDOW CLOSE 4
  291. RETURN
  292.  
  293. ' Various Subprograms
  294. ' -------------------
  295. SUB Logo80 (Depth%) STATIC
  296. SHARED Blk,Blu,Grn,Cyn,Red,Mag,Yel,Wht
  297. IF First=0 THEN
  298.   First=1
  299.   SCREEN 1,640,200,Depth%,2
  300.   WINDOW 2,,,16,1
  301.   COLOR ,0:CLS
  302.   PALETTE 0,0,0,0  :Blk=0:'Black
  303.   PALETTE 1,0,0,1  :Blu=1:'Blue
  304.   PALETTE 2,0,.75,0:Grn=2:'Green
  305.   PALETTE 3,0,1,1  :Cyn=3:'Cyan
  306.   PALETTE 4,1,0,0  :Red=4:'Red
  307.   PALETTE 5,1,0,1  :Mag=5:'Magenta
  308.   PALETTE 6,1,.8,0 :Yel=6:'Yellow
  309.   PALETTE 7,1,1,1  :Wht=7:'White
  310. END IF
  311. COLOR ,Blk:CLS
  312. AREA(376,8):AREA STEP(64,0):AREA STEP(-20,16)
  313. AREA STEP(0,24):AREA STEP(-24,0):AREA STEP(0,-24)
  314. COLOR Blu:AREAFILL
  315. AREA(360,8):AREA STEP(32,0):AREA STEP(0,12)
  316. AREA STEP(-16,0):AREA STEP(0,4):AREA STEP(8,0):AREA STEP(0,8)
  317. AREA STEP(-8,0):AREA STEP(0,4):AREA STEP(24,0):AREA STEP(0,12)
  318. AREA STEP(-40,0):COLOR Grn:AREAFILL
  319. AREA(328,8):AREA STEP(24,0):AREA STEP(0,28)
  320. AREA STEP(24,0):AREA STEP(0,12):AREA STEP(-48,0)
  321. COLOR Red:AREAFILL
  322. AREA(272,8):AREA STEP(64,0):AREA STEP(0,12)
  323. AREA STEP(-20,0):AREA STEP(0,28):AREA STEP(-24,0):AREA STEP(0,-28)
  324. AREA STEP(-20,0):COLOR Cyn:AREAFILL
  325. AREA(264,8):AREA STEP(16,0):AREA STEP(24,40)
  326. AREA STEP(-16,0):AREA STEP(-8,-12):AREA STEP(-16,0):AREA STEP(-8,12)
  327. AREA STEP(-16,0):COLOR Mag:AREAFILL
  328. AREA(200,8):AREA STEP(56,0):AREA STEP(0,16)
  329. AREA STEP(-24,0):AREA STEP(0,-4):AREA STEP(-8,0):AREA STEP(0,16)
  330. AREA STEP(8,0):AREA STEP(0,-4):AREA STEP(24,0):AREA STEP(0,16)
  331. AREA STEP(-56,0):COLOR Yel:AREAFILL
  332. COLOR Blu,Blk:LOCATE 24,7
  333. PRINT"Bryan D. Catley  2221 Glasgow Road  Alexandria  Virginia  22307-1819";
  334. END SUB
  335.  
  336. SUB BldGadgets (Num,t1(),t2$()) STATIC
  337. FOR n=0 TO Num-1
  338.   FOR m=0 TO 6
  339.     READ t1(n,m)
  340.   NEXT m
  341.   READ t2$(n)
  342. NEXT n
  343. END SUB
  344.  
  345. SUB DrawGadgets (Ga%,Gb%,t1(),t2$()) STATIC
  346. FOR n=Ga% TO Gb%
  347.   x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
  348.   bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
  349.   LINE(x1,y1)-(x2,y2),bg,bf:LINE(x1,y1)-(x2,y2),fg,B
  350.   IF bo>-1 THEN
  351.     LINE(x1+2,y1+2)-(x2-2,y2-2),fg,B
  352.     LINE(x2+1,y1+1)-(x2+1,y2+1),bo
  353.     LINE(x2+1,y2+1)-(x1+1,y2+1),bo
  354.     COLOR fg,bg:row%=INT(y1/8+2):col%=INT(x1/8+2)
  355.     LOCATE row%,col%:PRINT t2$(n)
  356.   END IF
  357. NEXT n
  358. END SUB
  359.  
  360. SUB GetGadget (Ga%,Gb%,t1(),t2$(),type) STATIC
  361. SHARED MouseX%,mouseY%,MouseInd
  362. WHILE MOUSE(0)=0:WEND
  363. r%=CSRLIN:c%=POS(0)
  364. mx=MOUSE(1):my=MOUSE(2)
  365. MouseX%=mx:mouseY%=my:MouseInd=0
  366. FOR n=Ga% TO Gb%
  367.   IF mx>t1(n,0) AND mx<t1(n,0)+t1(n,2) THEN
  368.     IF my>t1(n,1) AND my<t1(n,1)+t1(n,3) THEN
  369.       bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
  370.       IF bo>-1 THEN
  371.         x1=t1(n,0)+2:y1=t1(n,1)+2
  372.         x2=x1+t1(n,2)-4:y2=y1+t1(n,3)-4
  373.         LINE(x1,y1)-(x2,y2),fg,bf
  374.         COLOR bg,fg:row%=INT(y1/8+2):col%=INT(x1/8+2)
  375.         LOCATE row%,col%:PRINT t2$(n)
  376.       ELSE
  377.         IF bo=-1 THEN
  378.           x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
  379.           LINE(x1,y1)-(x2,y2),fg,bf:LINE(x1,y1)-(x2,y2),bg,B
  380.         END IF
  381.       END IF
  382.       type=n-Ga%+1:n=Gb%:MouseInd=1
  383.       IF bo<-1 THEN 
  384.         n%=type+Ga%-1:DrawGadgets n%,n%,t1(),t2$()
  385.       END IF
  386.     END IF
  387.   END IF
  388. NEXT n
  389. WHILE MOUSE(0)<>0:WEND
  390. LOCATE r%,c%
  391. END SUB
  392.  
  393.